home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
gsdb25.zip
/
GS_WINDW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-02
|
8KB
|
284 lines
UNIT GS_Windw;
{-----------------------------------------------------------------------------
Window Handler
GS_WINDW Copyright (c) Richard F. Griffin
15 November 1990
07 July 1991
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This unit handles creation of screen windows.
SHAREWARE -- COMMERCIAL USE RESTRICTED
Changes:
1 Apr 91 : Inserted checks for monochrome monitors to avoid
screen problems if the program attempts to set
colors. Changes are in GS_Wind_SetColors and
InitWin. The problem identification and fix were
provided by John Haluska, El Segundo CA,
CIS 74000,1106.
7 Jul 91 : Renamed from GS_Wind to GS_Windw to ensure all
references to windows routines are preprocessed
by GS_Winfc. This will allow use of another
windows handler instead of GS_Windw by changing
the procedure calls and uses statement in GS_Winfc.
------------------------------------------------------------------------------}
INTERFACE
USES
Crt,
Dos,
GS_Scrn;
Type
GS_Wind_Str80 = string[80];
GS_Wind_Pntr = ^GS_Wind_Objt;
GS_Wind_Objt = Object
x1,
y1,
x2,
y2 : integer; {Window size}
fg, {Foreground color}
bg, {Background color}
tx, {Text color}
bgh, {Inverted background color}
txh : byte; {Inverted text color}
CurX, {Last X position when new window}
CurY : integer; {Last Y position when new window}
dobox : boolean; {Flag to draw a box option}
boxname : GS_Wind_Str80;
{Name for a box when drawn}
copywin : boolean; {Flag to save old screen area}
{and restore when released}
winpntr : pointer; {Storage for old screen area}
lastwin : GS_Wind_Pntr;
{Pointer to last window object}
procedure MakBox;
procedure InitWin (x1w,y1w,x2w,y2w : integer;
txw,bgw,fgw,txx,bgx : integer;
dbox : boolean;
bname : GS_Wind_Str80;
cpywin : boolean);
procedure SetWin;
procedure RelWin;
end;
Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
Procedure GS_Wind_SetNmMode;
Procedure GS_Wind_SetFgMode;
Procedure GS_Wind_SetIvMode;
Procedure GS_Wind_GetWinSize(var wx1,wy1,wx2,wy2 : integer);
implementation
Var
win : GS_Wind_Objt;
Win_Ptr : ^GS_Wind_Objt;
ok_win : boolean;
i : integer;
Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
begin
with Win_Ptr^ do
begin
txw := tx;
bgw := bg;
fgw := fg;
txx := txh;
bgx := bgh;
end;
end;
Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
begin
with Win_Ptr^ do
if GS_Scrn_Mode <> Mono then
begin
tx := txw;
bg := bgw;
fg := fgw;
txh := txx;
bgh := bgx;
end;
end;
Procedure GS_Wind_SetNmMode;
begin
with Win_Ptr^ do
begin
TextColor(tx);
TextBackground(bg);
end;
end;
Procedure GS_Wind_SetFgMode;
begin
with Win_Ptr^ do
begin
TextColor(fg);
TextBackground(bg);
end;
end;
Procedure GS_Wind_SetIvMode;
begin
with Win_Ptr^ do
begin
TextColor(txh);
TextBackground(bgh);
end;
end;
Procedure GS_Wind_GetWinSize(var wx1,wy1,wx2,wy2 : integer);
begin
with Win_Ptr^ do
begin
wx1 := x1;
wy1 := y1;
wx2 := x2;
wy2 := y2;
end;
end;
procedure GS_Wind_Objt.MakBox;
var
wsmin,
wsmax : word;
wscx,
wscy,
wsattr : byte;
x, q : integer;
s : string;
begin
wsmin := WindMin;
wsmax := WindMax;
wsattr := TextAttr;
wscx := wherex;
wscy := wherey;
TextColor(fg);
window (1,1,80,25);
FillChar(s[1],80,#205);
x := succ(x2-x1);
s[0] := chr(x);
s[1] := #213;
if length(boxname) > 0 then
begin
if length(boxname) > x-2 then boxname[0] := chr(x-2);
x := (x-length(boxname)) div 2;
move(boxname[1],s[x+1],length(boxname));
end;
s[length(s)] := #184;
gotoxy(x1,y1);
write(s);
for q := y1+1 to y2-1 do
begin
gotoxy(x1,q);
write(#179);
gotoxy(x2,q);
write(#179);
end;
gotoxy(x1,y2);
FillChar(s[1],80,#205);
s[1] := #212;
s[0] := chr(pred(length(s)));
write(s);
GS_Scrn_Put_Char(x2,y2,#190);
WindMin := wsmin;
WindMax := wsmax;
TextAttr := wsattr;
gotoxy(wscx,wscy);
end;
procedure GS_Wind_Objt.SetWin;
begin
lastwin := win_ptr;
win_Ptr := @Self;
lastwin^.CurX := whereX;
lastwin^.CurY := wherey;
if copywin then
GS_Scrn_Get_Win(x1,y1,x2,y2,winpntr^);
TextColor(fg);
TextBackground(bg);
if dobox then
begin
MakBox;
window(x1+1, y1+1, x2-1, y2-1)
end else
window(x1, y1, x2, y2);
TextColor(tx);
ClrScr;
end;
procedure GS_Wind_Objt.RelWin;
begin
if copywin then
GS_Scrn_Put_Win(x1,y1,x2,y2,winpntr^);
win_Ptr := lastwin;
TextColor(lastwin^.tx);
TextBackground(lastwin^.bg);
if lastwin^.dobox then
begin
window(lastwin^.x1+1, lastwin^.y1+1, lastwin^.x2-1, lastwin^.y2-1)
end else
window(lastwin^.x1, lastwin^.y1, lastwin^.x2, lastwin^.y2);
gotoXY(lastwin^.CurX,lastwin^.CurY);
end;
procedure GS_Wind_Objt.InitWin(x1w,y1w,x2w,y2w : integer;
txw,bgw,fgw,txx,bgx : integer;
dbox : boolean;
bname : GS_Wind_Str80;
cpywin : boolean);
var
i,x,q : integer;
begin
x1 := x1w;
y1 := y1w;
x2 := x2w;
y2 := y2w;
if GS_Scrn_Mode = Mono then
begin
fg := LightGray;
bg := Black;
tx := LightGray;
txh := Black;
bgh := LightGray;
end
else
begin
fg := fgw;
bg := bgw;
tx := txw;
txh := txx;
bgh := bgx;
end;
dobox := dbox;
boxname := bname;
copywin := cpywin;
if cpywin then
GetMem(winpntr,(((x2-x1)+1) * ((y2-y1)+1)) * 2)
else winpntr := nil;
end;
begin
win.InitWin (1,1,80,25,7,0,7,0,7,FALSE,'',FALSE);
win_ptr := @win;
win.SetWin;
win.lastwin := win_Ptr;
end.